home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / aie8911.zip / TRACE.ARI < prev    next >
Text File  |  1989-06-03  |  13KB  |  466 lines
  1.  
  2.  
  3.  
  4. %%%%%%%%%% end prepcomp generated declarations %%%%%%%%%%%%%%%%%%%%
  5.  
  6. :- module trace .
  7.  
  8. :- extrn har_global_value / 1  : interp.
  9. :- extrn trace_trace / 0 : interp.
  10.  
  11.  
  12.  
  13.  
  14. /*************************************************************************/
  15. /************************   Top of trace.ari     *************************/
  16. /*************************************************************************/
  17. /*  trace_message(X) writes a user-defined trace message on the screen,
  18.  
  19.     example:
  20.  
  21.              trace_message([$X=$,X])
  22.  
  23.     would write when X=3,
  24.  
  25.            % **TRACE***:  X=3
  26.  
  27.     Note: a fancier version that writes also to a file is in Prolog Tools.
  28.           This short version saves scarce space in the interpreter.
  29.  
  30. */
  31.  
  32.  
  33.  
  34. % :- segment(code).
  35. /*
  36. :- public trace_message/1:far.
  37. :- visible   trace_message/1.
  38. :- public msg_to_err_file/1:far.
  39. :- visible   msg_to_err_file  /1.
  40. :- public      close_err_file / 0          : far.
  41. :- visible     close_err_file / 0          : far.
  42. :- public      close_log_file / 0          : far.
  43. :- visible     close_log_file / 0          : far.
  44. :- public      init_err_file / 0           : far.
  45. :- visible     init_err_file / 0           : far.
  46. :- public      init_log_file / 0           : far.
  47. :- visible     init_log_file / 0           : far.
  48. :- public      err_log  / 1                : far.
  49. :- visible     err_log  / 1                : far.
  50.  
  51. :- extrn               bottom_row / 1          : far,
  52.                        err_file_msg / 1        : interp,
  53.                        err_filename / 1        : interp,
  54.                        log_file_msg / 1        : interp,
  55.                        log_filename / 1        : interp,
  56.                        getglobal / 2           : far,
  57.                        is_nonempty_list / 1    : far,
  58.                        press_any / 0           : far,
  59.                        rem_global_value / 1    : far,
  60.                        setglobal / 2           : far,
  61.                        trace_trace / 0         : interp.
  62. */
  63.  
  64. err_file_msg($Error file:$).
  65. err_filename($err.log$).
  66. log_file_msg($log file:$).
  67. log_filename($log.log$).
  68.  
  69. trace_trace :- fail.
  70.  
  71. %%%%%%%%%%%%%%%%%%% msg_to_err_file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  72. /*
  73. msg_to_err_file( X)
  74. Writes a msg. X to both the screen and to the error file.
  75. */
  76.  
  77. msg_to_err_file( X) :-
  78.       get_err_handle(Handle),
  79.       trace_message_hlpr(Handle,X).
  80.  
  81. %%%%%%%%%%%%%%%%%%% trace_message %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  82. /*
  83. trace_message(X)
  84. Writes a msg. X to both the screen and to the log file.
  85. */
  86.  
  87. trace_message(Flag, Msg) :-
  88.      call( Flag),   !,
  89.      ( trace_message(Msg) , ! ; true).
  90. trace_message( _  , Msg) :- !.
  91.  
  92.  
  93. trace_message(X):-
  94.        (X==pause,!;
  95.         X==$pause$),!,
  96.        press_any.
  97.  
  98. trace_message(X):-
  99.       get_trace_handle(Handle),
  100. %      nl, write($+++++++ handle = $), write(Handle),
  101.       trace_message_hlpr(Handle,X).
  102.  
  103. trace_message_hlpr(Handle,X) :-
  104.       leadoff([1, Handle]),
  105.       trace_msg_hlpr2([1,Handle],X).
  106.  
  107. trace_msg_hlpr2( Handles ,[])  :- !,t_nl( Handles).
  108. trace_msg_hlpr2( Handles ,[H|T])  :- !,
  109.        write_message(  Handles, H ),!,
  110.        trace_msg_hlpr2( Handles, T ).
  111. trace_msg_hlpr2( Handles, X ) :- trace_msg_hlpr2( Handles, [X] ),
  112.                                   !.
  113.  
  114.  
  115. leadoff( [] ) :- !.
  116. leadoff( [H | T ] ) :-
  117.     leadoff_hlpr(H),
  118.     leadoff(T).
  119.  
  120. leadoff_hlpr( X) :-
  121.     integer(X),
  122.     X > 1,
  123.     !,
  124.     t_nl([ X    ]),
  125.     t_write( [   X ], $% **TRACE***: $).
  126.  
  127. leadoff_hlpr( X) :-
  128.     integer(X),
  129.     X = 1,
  130.     !,
  131.     bottom_row(Row),
  132.     tmove(Row,0),
  133.     write(  $% **TRACE***: $).
  134.  
  135. leadoff_hlpr( _ ) :- !.
  136.  
  137. write_message(Handles,X) :- var(X),!, t_write(Handles,$VAR$).
  138. write_message(Handles,X) :- is_nonempty_list(X),!, t_write_list(Handles,X).
  139. write_message(Handles,X) :- write_message_hlpr(Handles,X).
  140.  
  141. %  write_message_hlpr(Handle,X) :-
  142. %              nl, write($ write_message_hlpr : $), write( X),fail.
  143. write_message_hlpr(Handles,X) :- string(X),!, t_write(Handles,X).
  144. write_message_hlpr(Handles,X) :- var(X),!, t_write(Handles,$VAR$).
  145. write_message_hlpr(Handles,X) :- t_writeq(Handles,X).
  146.  
  147. t_nl( []) :- !.
  148.  
  149. t_nl( [H | T ]) :-
  150.      !,
  151.      t_nl_hlpr( H),
  152.      t_nl( T ).
  153.  
  154. t_nl( X) :-
  155.     integer(X),
  156.     !,
  157.     t_nl([X]).
  158.  
  159. t_nl( _).
  160.  
  161. t_nl_hlpr( H ) :-
  162.       H >=0,! ,
  163.       nl(H )  ,
  164.       !.
  165. t_nl_hlpr( _ ) :- !.
  166.  
  167.  
  168.  
  169. t_write( [  ],      X) :-!.
  170. t_write( [ H | T ], X) :-
  171.      t_write_hlpr( H, X ) ,
  172.      !,
  173.      t_write( T , X).
  174. t_write( X) :-
  175.     integer(X),
  176.     !,
  177.     t_write([X]).
  178. t_write( _) .
  179.  
  180. t_write_hlpr( H, X ) :-
  181.       H >=0,
  182.       ! ,
  183.       write(H , X).
  184. t_write_hlpr( _, _ ) :- !.
  185.  
  186.  
  187.  
  188. t_writeq(  [  ],      X) :-!.
  189. t_writeq(  [ H | T ], X) :-
  190.      t_writeq_hlpr( H, X ) ,
  191.      t_writeq( T , X).
  192. t_writeq( X) :-
  193.     integer(X),
  194.     !,
  195.     t_writeq([X]).
  196. t_writeq( _ ) :-!.
  197.  
  198. t_writeq_hlpr( H, X ) :-
  199.       H >=0,
  200.       ! ,
  201.       write_fact_hlpr( H , X   , 0, 0, 1, Used).
  202. t_writeq_hlpr( _, _ ) :- !.
  203.  
  204.  
  205. t_write_list(Handles,[H|T]):-
  206.           %   nl, write($ t_write_list : $), write( [H|T]) ,
  207.           t_write(Handles,$[$) ,        !,
  208.           write_message_hlpr(Handles,H),     !,
  209.           t_write_list_hlpr(Handles,T).
  210. t_write_list_hlpr(Handles,[]) :-
  211.           t_write(Handles,$]$) ,        !.
  212. t_write_list_hlpr(Handles,[H|T]) :-
  213.           %   nl, write($ t_write_list_hlpr : $), write( [H|T]) ,
  214.           t_write(Handles,$,$) ,        !,
  215.           tget(_,Col),                 !,
  216.           %   nl, write($ a tget, Col = $), write( Col  ) ,
  217.           t_write_list_cond_nl(Handles, Col),!,
  218.           write_message_hlpr(Handles,H),  !,
  219.           t_write_list_hlpr(Handles,T) .
  220.  
  221. t_write_list_cond_nl(Handles, Col)  :-
  222.        Col > 40,   !,
  223.        t_nl(Handles),
  224.        t_write(Handles,$% $).
  225. t_write_list_cond_nl(Handles, _  ):- t_write(Handles, $ $).
  226.  
  227. /*************************************************************************/
  228. /***********************  Log file stuff          ************************/
  229. /*************************************************************************/
  230.  
  231.  
  232.  
  233. init_log_file :-
  234. %   call(log_filename(File)),
  235.          log_filename(File) ,
  236. %   call(log_file_msg(Msg)),
  237.          log_file_msg(Msg) ,
  238.     init_file(File, log_file_handle, Msg).
  239.  
  240. init_err_file :-
  241. %   call(err_filename(File)),
  242. %   call(err_file_msg(Msg )),
  243.          err_filename(File ),
  244.          err_file_msg(Msg ) ,
  245.     init_file(File, err_file_handle, Msg).
  246.  
  247. init_file(File, Variable, Msg) :-
  248.    create(Handle,File),
  249.    close(Handle),
  250.    open( Handle2,File, ra),
  251.    setglobal(Variable, Handle2),
  252. %      nl, write($+++++++ $), write(Variable),
  253. %           write($ handle = $), write(Handle),
  254.    (trace_trace, !,
  255.       trace_message([Msg]);
  256.     true).
  257.  
  258. close_log_file :-    close_file( log_file_handle  ).
  259. close_err_file :-    close_file( err_file_handle  ).
  260.  
  261. close_file( Variable) :-
  262.    getglobal(Variable, Handle),
  263.    close( Handle),
  264.    rem_global_value( Variable ).
  265.  
  266. get_trace_handle(Handle) :-
  267.       getglobal(log_file_handle, Handle),!.
  268. get_trace_handle(  -1  ) :- !.
  269.  
  270. get_err_handle(Handle) :-
  271.       getglobal(err_file_handle, Handle),!.
  272. get_err_handle(  -1  ) :- !.
  273.  
  274. err_log( X) :-
  275.       getglobal(err_file_handle, Handle),
  276.       trace_message_hlpr(Handle,X).
  277.  
  278.  
  279. %%%%%%%%%%%%%%%%  global variable predicates %%%%%%%%%%%%%%%%%%%%%%%
  280. % note variable in the following refers to a PROLOG ATOM used as
  281. % a global varible in the application.
  282.  
  283. %%%%%%%%%%%%%%%% setglobal : set value of global variable %%%%%%%%%%
  284.  
  285. setglobal( Var, Val ) :-
  286.        rem_global_value( Var),
  287.        Form =.. [Var, Val],
  288.        asserta( Form),
  289.        let_have_global_value( Var).
  290.  
  291. let_have_global_value( Var) :-
  292.        asserta(har_global_value( Var)).
  293.  
  294. %%%%%%%%%%%%%%%% getglobal : get value of global variable %%%%%%%%%%
  295.  
  296. getglobal( Var, Val) :-
  297.        has_global_value( Var),
  298.        Form =.. [Var, Val],
  299.        call( Form).
  300.  
  301. %%%%%%%%%%%%%%%% has_global_value : true if variable has global value %%%%%
  302.  
  303. has_global_value( Var)  :-
  304.        call(har_global_value( Var)).
  305.  
  306. %%%%%%%%%%%%%%%% rem_global_value : remove global value %%%%%%%%%%%%%%%%%%%
  307.  
  308. rem_global_value( Var) :-
  309.        has_global_value( Var),
  310.        Form =.. [Var, _],
  311.        retract( Form),
  312.        retract( har_global_value( Var)),!.
  313. rem_global_value( _  ).
  314.  
  315.  
  316. /*************************************************************************/
  317. /******* is_nonempty_list : true if argument is a non-empty list *********/
  318. /*************************************************************************/
  319.  
  320. is_nonempty_list([_|_]).
  321.  
  322.  
  323. /*  test
  324. tt :- init_log_file,
  325.       trace_message($hi there$),
  326.       close_log_file,
  327.       shell($type log.log$).
  328. */
  329.  
  330. bottom_row(Row) :-
  331.      tget(R,C),
  332.      get_cursor(L,H),
  333.          % make cursor invisible for search on screen
  334.      set_cursor(111,0),
  335.      bottom_row_hlpr(24,Row),
  336.          % make cursor visible after search on screen
  337.      set_cursor(L,H),
  338.      tmove(R,C).
  339.  
  340. bottom_row_hlpr(Cur, Cur):-
  341.     tmove( Cur,0),!.
  342. bottom_row_hlpr(Cur,Row) :-
  343.       Cur1 is Cur-1,
  344.       bottom_row_hlpr(Cur1,Row).
  345.  
  346. /************  press key to continue    ***********************************/
  347.  
  348. press_any :-   %  message about pressing key
  349.         trace_message($Press any key to continue ...$),
  350.                % get user keystroke without echo
  351.         flush,
  352.         get0_noecho( _ ) .
  353.  
  354. /******** write_fact *************************************************/
  355. /* writess a fact to where it belongs.
  356.  
  357. CALL : write_fact ( Out_handle, Fact)
  358.  
  359. INPUT ARGS:
  360.  
  361.       Out_handle : where output goes, either file handle or
  362.                    prolog_idb
  363.  
  364.       Fact : what to write out
  365.  
  366. */
  367.  
  368. :- mode write_fact( +, +).
  369.  
  370. write_fact( Out_handle, Fact) :-
  371.         trace_message([$i write_fact, Out_handle = $, Out_handle]),
  372.         fail.
  373.  
  374. write_fact( Out_handle, Fact) :-
  375.          means_put_in_prolog_idb( Out_handle) ,
  376.          !,
  377.          assertz( Fact).
  378.  
  379. write_fact( Out_handle, Fact) :-
  380.       write_fact_hlpr( Out_handle, Fact, 0, 0, 1, Used),
  381.       write( Out_handle, $.$),
  382.       nl( Out_handle ),
  383.       (   Used > 1, !, nl(Out_handle)
  384.        ;  true).
  385.  
  386.  
  387. write_fact_hlpr( Out_handle, Fact, Indent, Current, Lines_used,
  388.                   Total_lines) :-
  389.          Tabs is Indent - Current,
  390.          tab(Out_handle, Tabs),
  391.          string_term( Sfact, Fact),
  392.          string_length( Sfact, Factlnth),
  393.          OK is 76 - Indent,
  394.          (      Factlnth =< OK,
  395.                 !,
  396.                 writeq( Out_handle, Fact),
  397.                 Total_lines is Lines_used
  398.             ;
  399.                 write_fact_hlpr2( Out_handle, Fact, Indent,
  400.                                    Current, Lines_used, Total_lines)).
  401.  
  402. write_fact_hlpr2( Out_handle, Fact, _ , _ , Lines_in, Lines_in) :-
  403.            atomic( Fact),
  404.            !,
  405.            writeq( Out_handle, Fact) .
  406.  
  407. write_fact_hlpr2( Out_handle,  S:V , N, Current , Lines_used, Total_lines) :-
  408.            !,
  409.            write_fact_hlpr( Out_handle, S, N, Current, Lines_used, Sofar1),
  410.            write(Out_handle, $ : $),
  411.            nl( Out_handle),
  412.            N3 is N+3,
  413.            write_fact_hlpr( Out_handle, V, N3, 0, Sofar1, Total_lines).
  414.  
  415. write_fact_hlpr2( Out_handle, [H|T], N, Current , Lines_used, Total_lines) :-
  416.            !,
  417.            write(Out_handle, $[$),
  418.            NewN is N +  1,
  419.            Current1 is Current+1,
  420.            write_arg( Out_handle, H, T, NewN, Current1, Lines_used, Sofar),
  421.            write_fact_hlpr3( Out_handle, T, NewN, 0, Sofar, Total_lines),
  422.            write( Out_handle, $]$).
  423.  
  424. write_fact_hlpr2( Out_handle, Fact, N, Current, Used, Total ) :-
  425.            Fact =..[ Functor | Args],
  426.            atom_string( Functor, Sfunctor),
  427.            string_length( Sfunctor, Functor_lnth),
  428.            write(Out_handle, Functor),
  429.            write(Out_handle, $($),
  430.            NewN is N + Functor_lnth + 1,
  431.            New_used is Used + 1,
  432.            Current1 is Current+ Functor_lnth +1,
  433.            write_args( Out_handle, Args, NewN, Current1, New_used, Total).
  434.  
  435. write_args( Out_handle,   [], _, _, Used, Used ) :- !.
  436.  
  437. write_args( Out_handle, [Arg | Rest], N, Current, Used, Total) :-
  438.            write_arg( Out_handle, Arg, Rest, N, Current, Used , Sofar),
  439.            write_fact_hlpr3( Out_handle, Rest, N, 0, Sofar, Total),
  440.            write( Out_handle, $)$).
  441.  
  442. write_fact_hlpr3( Out_handle, [], _ , _, Used, Used) :-  !.
  443.  
  444. write_fact_hlpr3( Out_handle, [H|T],  NewN, Current, Used, Total) :-
  445.            Tabs is NewN - Current,
  446.            tab( Out_handle, Tabs),
  447.            write_arg( Out_handle, H , T, NewN , NewN, Used, Sofar),
  448.            write_fact_hlpr3( Out_handle, T,  NewN, 0, Sofar, Total ).
  449.  
  450. write_arg( Out_handle, Arg, Rest, N , Current, Sofar, Total) :-
  451.            write_fact_hlpr( Out_handle, Arg, N, Current, Sofar, Sofar1),
  452.            (    non_empty( Rest ),
  453.                 !,
  454.                 write( Out_handle, $,$),
  455.                 nl( Out_handle),
  456.                 Total is Sofar1 + 1
  457.              ;
  458.                 true,
  459.                 Total is Sofar1
  460.            ).
  461.  
  462.  
  463. means_put_in_prolog_idb( prolog_idb) .
  464.  
  465. /********************** end of file **************************************/
  466.